home *** CD-ROM | disk | FTP | other *** search
/ FM Towns: Free Software Collection 10 / FM Towns Free Software Collection 10.iso / fb386 / lib / blb / sample / selector.bas < prev    next >
Encoding:
BASIC Source File  |  1995-02-17  |  10.0 KB  |  159 lines
  1. 10 CLEAR,,,,,100000:DEFINT A-Z:DEF FONT"システム   12ﾄﾞｯﾄ"
  2. 20 SCREEN 2:SCREEN@0:CONSOLE 0,24,0:COLOR 7,0,7,4:CLS:BLB_RESO_X=1024:BLB_RESO_Y=768
  3. 30 PALETTE 1,[112,32,176]:PALETTE 6,[192,192,192]:PALETTE 7,[112,112,112]:PALETTE 8,[32,32,32]
  4. 32 PALETTE 9,[176,128,224]:PALETTE 15,[255,255,255]:LINE(0,0)-(1023,767),PSET,%6,BF
  5. 50 LENGTH=60:SEL=95:TITLE$="項目セレクタ":DIM BLB_MEM%(78000),SEL$(SEL)
  6. 60 FOR I=0 TO SEL:SEL$(I)=STRING$(LENGTH,CHR$(I+32)):NEXT
  7. 100 GOSUB *BLB_SELECTOR:PRINT SEL:END
  8. 60400 '------------------- マウスカーソル形状設定 ver 1.60 一画面モード専用 --------------------------
  9. 60401 '入力 mousepat = マウスパターン番号
  10. 60402 '                (0=通常 1=時計 2=鉛筆 3=手 4=毛抜き 5=スポイト 6=指 7=筆 8=カッター)
  11. 60403 '                ( 負数はアイコン番号(絶対値)。絵柄については TOWNS GEARﾃﾞｨｸｼｮﾅﾘ参照)
  12. 60404 '                (         ただし､負数を指定したときは読み取り位置の補正は行われない)
  13. 60405 *BLB_MOUSEPAT
  14. 60406  IF BLB_MOUSEPAT%=0 THEN DIM BLB_MA&(31),BLB_MD&(31):MOUSE 0:MOUSE 1,320,240,0:BLB_MOUSEPAT%=1
  15. 60407  MOUSE 3,0,INP(&H3B06):MOUSE 3,1,INP(&H3B06)
  16. 60408  IF MOUSEPAT<0 THEN *BLB_MOUSEPAT2
  17. 60409  FOR I%=0 TO 31:BLB_MA&(I%)=PEEK([264]&H2D080+I%*4+MOUSEPAT*256,4)
  18. 60410  BLB_MD&(I%)=BLB_MA&(I%) OR PEEK([264]&H2D000+MOUSEPAT*256+I%*4,4) XOR -1
  19. 60411  NEXT:MOUSE 1,,,1
  20. 60412  MOUSE 6,0,BLB_MA&,BLB_MD&,ASC(MID$("1?1:21111",MOUSEPAT+1))-48,ASC(MID$("1?1:L111N",MOUSEPAT+1))-48:RETURN
  21. 60413 *BLB_MOUSEPAT2
  22. 60414  FOR I%=0 TO 31:BLB_MA&(I%)=PEEK([264]&H27F80+I%*4-MOUSEPAT*256,4)
  23. 60415  BLB_MD&(I%)=(BLB_MA&(I%)XOR-1)AND(PEEK([264]&H27F00-MOUSEPAT*256+I%*4,4)XOR-1)
  24. 60416  NEXT:MOUSE 1,,,1:MOUSE 6,0,BLB_MA&,BLB_MD&,15,15:RETURN
  25. 61800 '-------------------------- 項目選択ルーチン version 1.12 --------------------------------------
  26. 61801 '入力  LENGTH  = 文字列の長さ
  27. 61802 '      SEL     = 項目数
  28. 61803 '      SEL$(n) = 表示する文字列
  29. 61804 '      TITLE$  = タイトル
  30. 61805 '出力  SEL     = 項目番号(=0,1,2,･･･) 負数のとき未選択
  31. 61806 '変数  A%,B%,C%,D%,I%,J%,BLB_H%,BLB_MX%,BLB_MY%,BLB_M%,BLB_DX%,BLB_DY%,BLB_W%,BLB_T%
  32. 61807 *BLB_SELECTOR
  33. 61808  BLB_W%=LENGTH*6+40:BLB_DX%=320-BLB_W%\2:BLB_DY%=155:MOUSEPAT=0:GOSUB *BLB_MOUSEPAT
  34. 61809  MOUSE 1,,,0:GET@A(BLB_DX%,BLB_DY%)-(BLB_DX%+BLB_W%,BLB_DY%+170),BLB_MEM%
  35. 61810  LINE(BLB_DX%,BLB_DY%)-STEP(BLB_W%,170),PSET,%8,BF,7
  36. 61811  LINE(BLB_DX%,BLB_DY%)-STEP(BLB_W%,16),PSET,%8,BF,%9
  37. 61812  LINE(BLB_DX%,BLB_DY%)-STEP(32+LEN(TITLE$)*6,16),PSET,%8,BF
  38. 61813  SYMBOL(BLB_DX%+22,BLB_DY%+3),TITLE$,.75!,.75!,7
  39. 61814  LINE(BLB_DX%+2,BLB_DY%+2)-STEP(12,12),PSET,7,BF,%6
  40. 61815  LINE(BLB_DX%+2,BLB_DY%+2)-STEP(12,12),PSET,7:LINE(BLB_DX%+2,BLB_DY%+14)-STEP(12,-12),PSET,7
  41. 61816  LINE(BLB_DX%+BLB_W%-2,BLB_DY%)-STEP(1,170),PSET,%8,B
  42. 61817  LINE(BLB_DX%,BLB_DY%+169)-STEP(BLB_W%,0),PSET,%8
  43. 61818  LINE(BLB_DX%+3,BLB_DY%+20)-STEP(LENGTH*6+13,127),PSET,%8,B:A%=BLB_DX%+BLB_W%-21
  44. 61819  LINE(A%,BLB_DY%+36)-STEP(16,95),PSET,%8,B
  45. 61820  LINE(A%,BLB_DY%+20)-STEP(16,14),PSET,%8,B:SYMBOL(A%+3,BLB_DY%+21),"▲",.75!,.75!,%8
  46. 61821  LINE(A%,BLB_DY%+133)-STEP(16,14),PSET,%8,B:SYMBOL(A%+3,BLB_DY%+134),"▼",.75!,.75!,%8
  47. 61822  FOR I%=1 TO 2:CONNECT(BLB_DX%+BLB_W%-40*I%-1,BLB_DY%+150)-STEP(34,0)-STEP(1,1)-STEP(0,14)-STEP(-1,1)-STEP(-34,0)-STEP(-1,-1)-STEP(0,-14),%8
  48. 61823  SYMBOL(BLB_DX%+BLB_W%-40*I%+5,BLB_DY%+152),MID$("取消選択",I%*4-3,4),.75!,.75!,%8:NEXT
  49. 61824  BLB_H%=0:BLB_M%=-1:GOSUB *BLB_SEL_PUTSTR:MOUSE 1,,,1:WHILE INKEY$<>"":WEND
  50. 61825 *BLB_SEL_MAIN
  51. 61826  WAIT 1:IF BLB_T%<150 THEN BLB_T%=BLB_T%+1
  52. 61827  A%=ASC(INKEY$+" "):IF A%=24 THEN SEL=-1:GOTO *BLB_SEL_END
  53. 61828  IF A%=13 AND BLB_M%>=0 THEN SEL=BLB_M%:GOTO *BLB_SEL_END
  54. 61829  IF MOUSE(2,0)=0 THEN *BLB_SEL_MAIN ELSE BLB_MX%=MOUSE(0)-BLB_DX%:BLB_MY%=MOUSE(1)-BLB_DY%
  55. 61830  IF BLB_MX%<0 OR BLB_MY%<0 OR BLB_MX%>BLB_W% OR BLB_MY%>170 THEN *BLB_SEL_MAIN
  56. 61831  IF BLB_MX%>1 AND BLB_MX%<15 AND BLB_MY%>1 AND BLB_MY%<15 THEN *BLB_SEL_EXIT
  57. 61832  IF BLB_MX%>4 AND BLB_MX%<BLB_W%-24 AND BLB_MY%>20 AND BLB_MY%<146 THEN *BLB_SEL_MARK
  58. 61833  IF BLB_MX%>BLB_W%-22 AND BLB_MX%<BLB_W%- 4 AND BLB_MY%> 20 AND BLB_MY%< 34 THEN *BLB_SEL_UPDOWN
  59. 61834  IF BLB_MX%>BLB_W%-22 AND BLB_MX%<BLB_W%- 4 AND BLB_MY%>133 AND BLB_MY%<147 THEN *BLB_SEL_UPDOWN
  60. 61835  IF BLB_MX%>BLB_W%-42 AND BLB_MX%<BLB_W%- 6 AND BLB_MY%>149 AND BLB_MY%<165 THEN *BLB_SEL_YESNO
  61. 61836  IF BLB_MX%>BLB_W%-82 AND BLB_MX%<BLB_W%-46 AND BLB_MY%>149 AND BLB_MY%<165 THEN *BLB_SEL_YESNO
  62. 61837  IF BLB_MX%>BLB_W%-22 AND BLB_MX%<BLB_W%- 4 AND BLB_MY%> 35 AND BLB_MY%<132 AND SEL>8 THEN *BLB_SEL_BAR
  63. 61838  IF BLB_MY%<16 THEN *BLB_SEL_MOVE
  64. 61839  GOTO *BLB_SEL_MAIN
  65. 61840 *BLB_SEL_YESNO
  66. 61841  J%=1+(MOUSE(4,0)-BLB_DX%>BLB_W%-42):B%=0
  67. 61842  WHILE MOUSE(2,0):BLB_MX%=MOUSE(0)-BLB_DX%+J%*40:BLB_MY%=MOUSE(1)-BLB_DY%
  68. 61843   A%=(BLB_MX%>BLB_W%-42)*(BLB_MX%<BLB_W%-6)*(BLB_MY%>149)*(BLB_MY%<165)
  69. 61844   IF A%<>B% THEN LINE(BLB_DX%+BLB_W%-40*J%-41,BLB_DY%+151)-STEP(34,14),XOR,%7,BF:B%=A%
  70. 61845  WEND:IF B%=0 THEN *BLB_SEL_MAIN
  71. 61846  LINE(BLB_DX%+BLB_W%-40*J%-41,BLB_DY%+151)-STEP(34,14),XOR,%7,BF
  72. 61847  IF J%=0 THEN SEL=-1 ELSE IF BLB_M%<>-1 THEN SEL=BLB_M% ELSE *BLB_SEL_MAIN
  73. 61848  GOTO *BLB_SEL_END
  74. 61849 *BLB_SEL_EXIT
  75. 61850  B%=0:WHILE MOUSE(2,0):BLB_MX%=MOUSE(0)-BLB_DX%:BLB_MY%=MOUSE(1)-BLB_DY%
  76. 61851   A%=(BLB_MX%>1)*(BLB_MY%>1)*(BLB_MX%<15)*(BLB_MY%<15)
  77. 61852   IF A%<>B% THEN LINE(BLB_DX%+2,BLB_DY%+2)-STEP(12,12),XOR,%7,BF:B%=A%
  78. 61853  WEND:IF B%=0 THEN *BLB_SEL_MAIN ELSE SEL=-1:GOTO *BLB_SEL_END
  79. 61854 *BLB_SEL_MOVE
  80. 61855  MOUSEPAT=3:GOSUB *BLB_MOUSEPAT:C%=BLB_MX%:D%=BLB_MY%:MOUSE 4,C%,D%,BLB_RESO_X-1-BLB_W%+C%,BLB_RESO_Y-171+D%
  81. 61856  LINE(BLB_DX%,BLB_DY%)-STEP(BLB_W%,170),XOR,%7,B
  82. 61857  A%=BLB_DX%:B%=BLB_DY%:FOR I%=0 TO 1:I%=1+MOUSE(2,0):BLB_MX%=MOUSE(0)-C%:BLB_MY%=MOUSE(1)-D%
  83. 61858  IF A%<>BLB_MX% OR B%<>BLB_MY% THEN LINE(A%,B%)-STEP(BLB_W%,170),XOR,%7,B:LINE(BLB_MX%,BLB_MY%)-STEP(BLB_W%,170),XOR,%7,B
  84. 61859  A%=BLB_MX%:B%=BLB_MY%:NEXT:MOUSE 4,0,0,BLB_RESO_X-1,BLB_RESO_Y-1:LINE(BLB_MX%,BLB_MY%)-STEP(BLB_W%,170),XOR,%7,B
  85. 61860  MOUSEPAT=0:GOSUB *BLB_MOUSEPAT:IF BLB_DX%=BLB_MX% AND BLB_DY%=BLB_MY% THEN *BLB_SEL_MAIN
  86. 61861  GET@A(BLB_DX%,BLB_DY%)-(BLB_DX%+BLB_W%,BLB_DY%+170),BLB_MEM%,39000
  87. 61862  PUT@A(BLB_DX%,BLB_DY%)-(BLB_DX%+BLB_W%,BLB_DY%+170),BLB_MEM%
  88. 61863  GET@A(BLB_MX%,BLB_MY%)-(BLB_MX%+BLB_W%,BLB_MY%+170),BLB_MEM%
  89. 61864  PUT@A(BLB_MX%,BLB_MY%)-(BLB_MX%+BLB_W%,BLB_MY%+170),BLB_MEM%,,,,,39000
  90. 61865  BLB_DX%=BLB_MX%:BLB_DY%=BLB_MY%:GOTO *BLB_SEL_MAIN
  91. 61866 *BLB_SEL_UPDOWN
  92. 61867  J%=-(MOUSE(5,0)-BLB_DY%>100):B%=0
  93. 61868  WHILE MOUSE(2,0):BLB_MX%=MOUSE(0)-BLB_DX%:BLB_MY%=MOUSE(1)-BLB_DY%-J%*113
  94. 61869   A%=(BLB_MX%>BLB_W%-22)*(BLB_MX%<BLB_W%-4)*(BLB_MY%>20)*(BLB_MY%<34)
  95. 61870   IF A%<>B% THEN LINE(BLB_DX%+BLB_W%-20,BLB_DY%+21+J%*113)-STEP(14,12),XOR,%7,BF:B%=A%
  96. 61871   IF A%=1 AND ((BLB_H%+8<SEL AND J%=1) OR (BLB_H%>0 AND J%=0)) THEN A%=J%*2-1:BLB_H%=BLB_H%+A%:GOSUB *BLB_SEL_SCROLL
  97. 61872  WEND:IF B%=1 THEN LINE(BLB_DX%+BLB_W%-20,BLB_DY%+21+J%*113)-STEP(14,12),XOR,%7,BF
  98. 61873  GOTO *BLB_SEL_MAIN
  99. 61874 *BLB_SEL_BAR
  100. 61875  MOUSE 4,BLB_DX%+BLB_W%-21,BLB_DY%+36,BLB_DX%+BLB_W%-5,BLB_DY%+130
  101. 61876  D%=MOUSE(5,0)-BLB_DY%-36-BLB_H%*92/(SEL+1)
  102. 61877  WHILE MOUSE(2,0)
  103. 61878   IF 36+BLB_H%*93/(SEL+1)<BLB_MY% AND 38+BLB_H%*93/(SEL+1)+837/(SEL+1)>BLB_MY% THEN
  104. 61879    WHILE MOUSE(2,0):A%=(MOUSE(1)-BLB_DY%-36-D%)*(SEL+1)/92
  105. 61880     IF A%<0 THEN A%=0 ELSE IF A%>SEL-8 THEN A%=SEL-8
  106. 61881     IF A%<>BLB_H% THEN
  107. 61882      B%=(A%-BLB_H%):BLB_H%=A%:MOUSE 1,,,0:GOSUB *BLB_SEL_PUTBAR
  108. 61883      IF ABS(B%)>8 THEN GOSUB *BLB_SEL_PUTSTR ELSE A%=B%:GOSUB *BLB_SEL_SCROLL
  109. 61884      MOUSE 1,,,1
  110. 61885     ENDIF
  111. 61886    WEND
  112. 61887   ELSE
  113. 61888    A%=BLB_H%+SGN(MOUSE(1)-BLB_DY%-36-BLB_H%*93/(SEL+1))*8
  114. 61889    IF A%<0 THEN A%=0 ELSE IF A%>SEL-8 THEN A%=SEL-8
  115. 61890    IF A%<>BLB_H% THEN MOUSE 1,,,0:BLB_H%=A%:GOSUB *BLB_SEL_PUTSTR:MOUSE 1,,,1
  116. 61891   ENDIF
  117. 61892   BLB_MY%=MOUSE(1)-BLB_DY%:D%=BLB_MY%-36-BLB_H%*92/(SEL+1)
  118. 61893  WEND:MOUSE 4,0,0,BLB_RESO_X-1,BLB_RESO_Y-1:GOTO *BLB_SEL_MAIN
  119. 61894 *BLB_SEL_MARK
  120. 61895  IF MOUSE(2,0)=0 THEN *BLB_SEL_MAIN
  121. 61896  A%=MOUSE(1)-BLB_DY%-21:BLB_MX%=MOUSE(0)-BLB_DX%
  122. 61897  IF BLB_MX%<4 OR BLB_MX%>15+LENGTH*6 OR A%<0 OR A%>125 OR A%>SEL*14+13 THEN A%=-1 ELSE A%=A%\14
  123. 61898  IF A%<0 THEN
  124. 61899   IF BLB_M%>=BLB_H% AND BLB_M%<BLB_H%+9 THEN GOSUB *BLB_SEL_PUTMARK:BLB_M%=-1
  125. 61900   GOTO *BLB_SEL_MARK
  126. 61901  ENDIF
  127. 61902  IF BLB_M%<>A%+BLB_H% THEN
  128. 61903   IF BLB_M%>=BLB_H% AND BLB_M%<BLB_H%+9 THEN GOSUB *BLB_SEL_PUTMARK
  129. 61904   BLB_M%=A%+BLB_H%:GOSUB *BLB_SEL_PUTMARK:BLB_T%=0
  130. 61905  ENDIF
  131. 61906  IF BLB_T%>0 AND BLB_T%<INP(&H3B04)*25/32 THEN SEL=BLB_M%:GOTO *BLB_SEL_END
  132. 61907  BLB_T%=0:GOTO *BLB_SEL_MARK
  133. 61908 *BLB_SEL_PUTMARK
  134. 61909  LINE(BLB_DX%+4,BLB_DY%+21+(BLB_M%-BLB_H%)*14)-STEP(LENGTH*6+11,13),XOR,%7,BF:RETURN
  135. 61910 *BLB_SEL_PUTSTR
  136. 61911  FOR I%=0 TO 8:IF SEL>=I%+BLB_H% THEN GOSUB *BLB_SEL_PUT1STR
  137. 61912  NEXT:GOSUB *BLB_SEL_PUTBAR:RETURN
  138. 61913 *BLB_SEL_PUT1STR
  139. 61914  LINE(BLB_DX%+4,BLB_DY%+21+I%*14)-STEP(LENGTH*6+11,13),PSET,%15+(BLB_M%=I%+BLB_H%)*7,BF
  140. 61915  SYMBOL(BLB_DX%+10,BLB_DY%+22+14*I%),SEL$(I%+BLB_H%),.75!,.75!,%8-(BLB_M%=I%+BLB_H%)*7:RETURN
  141. 61916 *BLB_SEL_PUTBAR
  142. 61917  IF SEL<9 THEN LINE(BLB_DX%+BLB_W%-20,BLB_DY%+37)-STEP(14,93),PSET,%8,BF,7:RETURN
  143. 61918  LINE(BLB_DX%+BLB_W%-21,BLB_DY%+36)-STEP(16,BLB_H%*93/(SEL+1)+1),PSET,%8,BF,%9
  144. 61919  LINE STEP(-1,0)-STEP(-14,837/(SEL+1)),PSET,%8,BF,7
  145. 61920  LINE STEP(-1,0)-(BLB_DX%+BLB_W%-5,BLB_DY%+131),PSET,%8,BF,%9:RETURN
  146. 61921 *BLB_SEL_SCROLL
  147. 61922  MOUSE 1,,,0
  148. 61923  IF A%>0 THEN
  149. 61924   GET@A(BLB_DX%+4,BLB_DY%+21+14*A%)-(BLB_DX%+BLB_W%-25,BLB_DY%+146),BLB_MEM%,39000
  150. 61925   PUT@A(BLB_DX%+4,BLB_DY%+21)-(BLB_DX%+BLB_W%-25,BLB_DY%+146-14*A%),BLB_MEM%,,,,,39000
  151. 61926   FOR I%=9-A% TO 8:GOSUB *BLB_SEL_PUT1STR:NEXT
  152. 61927  ELSE IF A%<0 THEN
  153. 61928   GET@A(BLB_DX%+4,BLB_DY%+21)-(BLB_DX%+BLB_W%-25,BLB_DY%+146-14*A%),BLB_MEM%,39000
  154. 61929   PUT@A(BLB_DX%+4,BLB_DY%+21-14*A%)-(BLB_DX%+BLB_W%-25,BLB_DY%+146),BLB_MEM%,,,,,39000
  155. 61930   FOR I%=0 TO -A%-1:GOSUB *BLB_SEL_PUT1STR:NEXT
  156. 61931  ENDIF
  157. 61932  GOSUB *BLB_SEL_PUTBAR:MOUSE 1,,,1:RETURN
  158. 61933 *BLB_SEL_END:PUT@A(BLB_DX%,BLB_DY%)-(BLB_DX%+BLB_W%,BLB_DY%+170),BLB_MEM%:RETURN
  159.